home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / FORM_SHAPI2154836132009.psc / FORM SHAPING / Module1.bas < prev    next >
BASIC Source File  |  2003-01-01  |  3KB  |  64 lines

  1. Attribute VB_Name = "Module1"
  2. 'i got this from www
  3. Option Explicit
  4.  
  5. Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
  6. Public Declare Function SetWindowRgn Lib "User32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  7. Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  8. Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  9. Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  10. Public Declare Function ReleaseCapture Lib "User32" () As Long
  11. Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  12. Public Const RGN_OR = 2
  13. Public Const WM_NCLBUTTONDOWN = &HA1
  14. Public Const HTCAPTION = 2
  15.  
  16. Public Function MakeRegion(picSkin As PictureBox) As Long
  17.     Dim X As Long, Y As Long, StartLineX As Long
  18.     Dim FullRegion As Long, LineRegion As Long
  19.     Dim TransparentColor As Long
  20.     Dim InFirstRegion As Boolean
  21.     Dim InLine As Boolean  ' Flags whether we are in a non-tranparent pixel sequence
  22.     Dim hDC As Long
  23.     Dim PicWidth As Long
  24.     Dim PicHeight As Long
  25.     
  26.     hDC = picSkin.hDC
  27.     PicWidth = picSkin.ScaleWidth
  28.     PicHeight = picSkin.ScaleHeight
  29.     
  30.     InFirstRegion = True: InLine = False
  31.     X = Y = StartLineX = 0
  32.     TransparentColor = GetPixel(hDC, 0, 0)
  33.     
  34.     For Y = 0 To PicHeight - 1
  35.         For X = 0 To PicWidth - 1
  36.             
  37.             If GetPixel(hDC, X, Y) = TransparentColor Or X = PicWidth Then
  38.                 ' We reached a transparent pixel
  39.                 If InLine Then
  40.                     InLine = False
  41.                     LineRegion = CreateRectRgn(StartLineX, Y, X, Y + 1)
  42.                     
  43.                     If InFirstRegion Then
  44.                         FullRegion = LineRegion
  45.                         InFirstRegion = False
  46.                     Else
  47.                         CombineRgn FullRegion, FullRegion, LineRegion, RGN_OR
  48.                         DeleteObject LineRegion
  49.                     End If
  50.                 End If
  51.             Else
  52.              
  53.              
  54.                 If Not InLine Then
  55.                     InLine = True
  56.                     StartLineX = X
  57.                 End If
  58.             End If
  59.         Next
  60.     Next
  61.     
  62.     MakeRegion = FullRegion
  63. End Function
  64.